home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The PC-SIG Library 9
/
The PC-SIG Library on CD ROM - Ninth Edition.iso
/
301_400
/
DISK0322
/
DISK0322.ZIP
/
SYNTH.BAS
< prev
next >
Wrap
BASIC Source File
|
1980-01-01
|
8KB
|
224 lines
5 REM THIS HAD BETTER WORK
10 DEFINT A-Z:ON ERROR GOTO 30
20 GOTO 50
30 'ERROR HANDLER
40 RESUME NEXT
50 OPTION BASE 1:DIM ROW(25)
60 FOR I=1 TO 25:READ ROW(I):NEXT I
70 DATA 6,25,20,2,15,24,1,13,7,9,5,18,3,14,19,4,8,11,23,12,22,10,16,17,21
80 WIDTH 40:KEY OFF:CLS:LOCATE ,,0
90 COLOR 7,0,1
100 FOR I = 1 TO 96
110 A = INT(RND*2400 + 1000)
120 PRINT STRING$(10,CHR$(14));
130 SOUND A,.01
140 SOUND 100 + I,.01
150 NEXT I
160 PLAY "L16O4GO5CEGE2G"
170 COLOR 15,0:LOCATE 13,13:PRINT" VERSION -0.01 ";
180 COLOR 0,15:LOCATE 9,8:PRINT" THE AMAZING,INCREDULOUS ";
190 COLOR 15,0:LOCATE 11,11:PRINT" SYNSONIC ORGANITRON ";
200 COLOR 31,0:LOCATE 20,5:PRINT" WARNING:";:COLOR 0,15:PRINT" PLEASE DO NOT COPY THIS PROGRAM IT TOOK ME AND MY BROTHER ALL DAY TO WRITE !
210 COLOR 15,3 :LOCATE 25,1:PRINT" PRESS ANY KEY TO CONTINUE ";
220 K$=INKEY$:IF K$ = "" THEN 220
230 COLOR 7,0,4
240 LOCATE 25,1:PRINT STRING$(79," "):LOCATE 25,1
250 FOR I = 1 TO 499
260 COLOR 15,0:PRINT STRING$(1,CHR$(17));:SOUND 19000,.01:
270 COLOR 0,15:PRINT STRING$(1,CHR$(16));:SOUND 8200,.01
280 NEXT I
290 COLOR 15,0:PRINT CHR$(17);
300 COLOR 15,0,0
310 PLAY "MNL4O1T255C2C8P8CD2"
320 LOCATE 4,3,0:PRINT "CONCEIVED...";
330 PLAY "D8P8G2G8P8F8P8E8P8D8P8C2":LOCATE 4,21:PRINT "COMPOSED...";
340 PLAY "C2C8P8CD2D8P8F2F8P8E-8P8D8P8C8P8O0B-2":LOCATE 6,11:PRINT "CONTRIVED...";
350 PLAY "B-2B-B-O1C2D2DDD+2":LOCATE 7,25:PRINT "DEVISED...";
360 PLAY "D+O0B-2B-B-O1C2"
370 LOCATE 9,3:PRINT "AND FORGED ";
380 PLAY "MBCG2GEDCG2G2D+DCGGCCGG2ECGG2E-C1O0C1"
390 PRINT "FROM THE CEREBRATIONS ";
400 LOCATE 11,2:PRINT "OF THE COSMIC COGNIZANT CONCIOUSNESSES ";
410 LOCATE 13,20:PRINT "OF..."
420 LOCATE 15,6:PRINT "JOSEPH EDWARD ";:COLOR 31,0:PRINT "`THE CHIMP'";:COLOR 15,0:PRINT" BATUTIS";
430 LOCATE 17,20:PRINT "AND";
440 LOCATE 19,6:PRINT "EDWARD JOSEPH ";:COLOR 31,0:PRINT "`EDDIE BABY'";:COLOR 15,0:PRINT" BATUTIS";
450 LOCATE 24,1:COLOR 15,0:PRINT " PRESS ANY KEY TO CONTINUE ";
460 FOR I=1 TO 2000:I=I:NEXT I
470 K$=INKEY$:IF K$="" THEN 470
480 FOR M=1 TO 20
490 FOR J=1 TO 25
500 LOCATE ROW(J),M+20:PRINT " ";
510 NEXT J
520 FOR L=1 TO 25
530 LOCATE ROW(L),21-M:PRINT " ";
540 NEXT L,M
550 CLS
560 CLS:SCREEN 1:IF FLAG<>0 THEN 590 ELSE FLAG=1
570 DIM BH1(500),BH2(500),TH1(500),TH2(500),RV1(500),RV2(500),LV1(500),LV2(500)
580 ON ERROR GOTO 30
590 COLOR 0,3
600 FOR A=14 TO 302 STEP 12
610 CIRCLE (A,4),4
620 NEXT A
630 FOR A=8 TO 196 STEP 9
640 CIRCLE (314,A),4
650 NEXT A
660 FOR A=314 TO 14 STEP -12
670 CIRCLE (A,196),4
680 NEXT A
690 FOR A=191 TO 8 STEP -9
700 CIRCLE (8,A),4
710 NEXT A
720 CIRCLE (14,4),4
730 COLOR 0,7
740 FOR A=26 TO 302 STEP 24
750 PAINT (A,4),2,3
760 NEXT A
770 GET (1,1)-(319,10),TH1
780 FOR A=26 TO 302 STEP 24
790 PAINT (A,4),0,3
800 NEXT A
810 FOR A=14 TO 302 STEP 24
820 PAINT (A,4),2,3
830 NEXT A:GET (1,1)-(319,10),TH2
840 FOR A=8 TO 196 STEP 18
850 PAINT (314,A),2,3
860 NEXT A
870 GET(310,1)-(319,199),RV1
880 FOR A=8 TO 196 STEP 18
890 PAINT (314,A),0,3
900 NEXT A
910 FOR A=17 TO 196 STEP 18
920 PAINT (314,A),2,3
930 NEXT A
940 GET(310,1)-(319,199),RV2
950 FOR A=314 TO 14 STEP -24
960 PAINT (A,196),2,3
970 NEXT A
980 GET (1,190)-(319,199),BH1
990 FOR A=314 TO 14 STEP -24
1000 PAINT (A,196),0,3
1010 NEXT A
1020 FOR A=302 TO 14 STEP -24
1030 PAINT (A,196),2,3
1040 NEXT A
1050 GET (1,190)-(319,199),BH2
1060 FOR A=183 TO 8 STEP -18
1070 PAINT (8,A),2,3
1080 NEXT A
1090 GET (1,1)-(12,199),LV1
1100 FOR A=183 TO 8 STEP -18
1110 PAINT (8,A),0,3
1120 NEXT A
1130 FOR A=191 TO 8 STEP -18
1140 PAINT (8,A),2,3
1150 NEXT A
1160 GET (1,1)-(12,199),LV2
1170 LOCATE 7,20:PRINT " MENU ";
1180 LOCATE 10,17:PRINT "A-ORGANITEK"
1190 LOCATE 12,17:PRINT "B-ORGANISCOPE"
1200 LOCATE 14,17:PRINT "C-BLUEZORG"
1210 LOCATE 16,17:PRINT "D-SPACEORG"
1220 LOCATE 18,17,0:PRINT "Q-QUIT"
1230 LOCATE 20,5:PRINT "(FIRST CHOOSE LETTER, THEN HIT":LOCATE 21,7:PRINT "LOWERCASE KEYS FOR TONES)"
1240 PLAY "MBL4T190MSO4P1GE8P8AP8G8FD8P8GP8F8E8P8CF8P8DGP8G8C2"
1250 A$ = INKEY$:IF A$<> "" THEN 1350
1260 PUT (1,1),TH1,XOR:PUT(1,1),TH2
1270 PUT (310,1),RV1,XOR:PUT(310,1),RV2
1280 PUT (1,190),BH1,XOR:PUT(1,190),BH2
1290 PUT (1,1),LV1,XOR:PUT(1,1),LV2
1300 PUT(1,1),TH2,XOR:PUT(1,1),TH1
1310 PUT(310,1),RV2,XOR:PUT(310,1),RV1
1320 PUT(1,190),BH2,XOR:PUT(1,190),BH1
1330 PUT(1,1),LV2,XOR:PUT(1,1),LV1
1340 GOTO 1250
1350 IF A$ = "A" THEN 1420
1360 IF A$ = "B" THEN 1570
1370 IF A$ = "C" THEN 1780
1380 IF A$ = "D" THEN 1910
1390 IF A$ = "Q" THEN 1410
1400 GOTO 1240
1410 GOTO 2070
1420 CLS:SCREEN 0:LOCATE ,,0
1430 COLOR 15,0,3:LOCATE 5,15:PRINT"ORGANITEK"
1440 LOCATE 11,3:PRINT"DEMONSTRATES HOW EACH STRIKE OF THE"
1450 LOCATE 13,3:PRINT "KEYBOARD CAN SET OFF A RAPID"
1460 LOCATE 15,3:PRINT "SUCCESSION OF INTERRELATED TONES."
1470 LOCATE 19,10:PRINT"CAPITAL Q TO RETURN"
1480 A$=INKEY$: IF A$="" THEN 1480
1490 IF A$ = "Q" THEN 560
1500 B$="\XZXXCXVXBXNMX,X./XAXSXDFXGXHJXKXLX;'X`XQWXEXRXTYXUXIOXPX[X]1X2X34X5X6X78X9X0-X="
1510 NO=INSTR(1,B$,A$):NM = NO + 5:NP = NO -5
1520 IF NM >80 THEN NM = 80
1530 IF NP < 0 THEN NP = 0
1540 NO$=STR$(NO):NP$ = STR$(NP):NM$ = STR$(NM)
1550 PLAY "L25T255N" + NO$+"N"+ NP$+"N"+NM$
1560 GOTO 1480
1570 CLS:SCREEN 0:LOCATE ,,0
1580 COLOR 15,0,3:LOCATE 5,15:PRINT"ORGANISCOPE"
1590 LOCATE 11,3:PRINT"DEMONSTRATES HOW TWO SUCCESSIVE STRIKES "
1600 LOCATE 13,3:PRINT "OF THE KEYBOARD CAN BE INTERELATED."
1610 LOCATE 15,3:PRINT "(IN THIS CASE HITTING ALL THE TONES IN- BETWEEN.)
1620 LOCATE 19,10:PRINT"CAPITAL Q TO RETURN"
1630 NM=20
1640 A$=INKEY$: IF A$="" THEN 1640
1650 IF A$ = "Q" THEN 560
1660 'B$="\ZXCVBNM,./ASDFGHJKL;'`QWERTYUIOP[]1234567890-="
1670 B$="\XZXXCXVXBXNMX,X./XAXSXDFXGXHJXKXLX;'X`XQWXEXRXTYXUXIOXPX[X]1X2X34X5X6X78X9X0-X="
1680 NO=INSTR(1,B$,A$)
1690 NO$=STR$(NO):NM$ = STR$(NM)
1700 IF NM=NO THEN 1640
1710 PLAY "L64T255N" + NO$+"N"+NM$
1720 PLAY "MLL18T255N" + NO$
1730 IF NM < NO THEN 1760
1740 IF NM > NO THEN 1770
1750 GOTO 1640
1760 NM = NM + 1:GOTO 1690
1770 NM = NM - 1:GOTO 1690
1780 CLS:SCREEN 0:LOCATE ,,0
1790 COLOR 15,0,3:LOCATE 5,15:PRINT"BLUEZORG"
1800 LOCATE 11,3:PRINT"DEMONSTRATES HOW THE SCALE CAN BE"
1810 LOCATE 13,3:PRINT "CHANGED FROM AN ORDINARY `C'"
1820 LOCATE 15,3:PRINT "SCALE TO A `C'BLUES SCALE."
1830 LOCATE 19,10:PRINT"CAPITAL Q TO RETURN"
1840 A$=INKEY$: IF A$="" THEN 1840
1850 IF A$ = "Q" THEN 560
1860 B$="\XXZXCVBXXNM,XX./ASDXXFGHXXJKL;'XX`QWXXERTYUXXIOPXX[]123XX123XX45678XX90-XX="
1870 NO=INSTR(1,B$,A$):NM = NO + 5:NP = NO -1:NO$=STR$(NO):NP$ = STR$(NP):NM$ = STR$(NM)
1880 'PLAY "L25T255N" + NO$+"N"+ NP$+"N"+NM$
1890 PLAY "MNL18T255N" + NO$
1900 GOTO 1840
1910 SCREEN 0:LOCATE ,,0:CLS
1920 COLOR 15,0,3:LOCATE 5,15:PRINT"SPACEORG"
1930 LOCATE 11,3:PRINT"DEMONSTRATES HOW THE SOUND AND PLAY"
1940 LOCATE 13,3:PRINT "COMMANDS CAN BE INTERTWINED"
1950 LOCATE 15,3:PRINT "RESULTING IN,AMONG OTHER THINGS,"
1960 LOCATE 17,3:PRINT"A DRONE TONE."
1970 LOCATE 19,10:PRINT"CAPITAL Q TO RETURN"
1980 A$=INKEY$: IF A$="" THEN 1980
1990 IF A$ = "Q" THEN 560
2000 B$=" \XZXXCXVXBXNMX,X./XAXSXDFXGXHJXKXLX;'X`XQWXEXRXTYXUXIOXPX[X]1X2X34X5X6X78X9X0-X="
2010 NO=INSTR(1,B$,A$):NM = NO + 1:NP = NO -1:NO$=STR$(NO):NP$ = STR$(NP):NM$ = STR$(NM)
2020 PLAY "L64T255N" + NO$+"N"+ NP$+"N"+NM$
2030 PLAY "MNL30T255N" + NO$
2040 SOUND 37,.5:SOUND 40,.5
2050 A$=INKEY$: IF A$ ="" THEN 2030
2060 IF A$= "Q"THEN 560 ELSE GOTO 2000
2070 SCREEN 0:CLS:COLOR 15,4,3:LOCATE,,0
2080 A$="O1DDDO0A8B8O1L4C+D8L8C+O0L4BA2.O1DC+O0BABG8L8F+L4ED2."
2090 CLS:COLOR 0:PLAY "MBXA$;":LOCATE 3,3:PRINT"DO YOUR PROGRAMS HAVE MORE BUGS THAN A `ROACH MOTEL'?"
2100 PLAY "XA$;":LOCATE 7,1:PRINT"IS YOUR DISK DRIVE POSSESSED??"
2110 B$="MBO0DF+ABG+A2.DAABO1C+D2.C+DC+O0BBA2.BBABGL2F+."
2120 PLAY "XB$;":LOCATE 9,3:PRINT "DOES YOUR MICROPROCESSOR HAVE THE PREDICTABILITY OF A FOUR YEAR OLD WITH HEMORRHOIDS???"
2130 C$="L4O1DC+O0BABG8L8F+L4ED2."
2140 PLAY "XC$;":LOCATE 14,15:COLOR 31,4,3:PRINT"!REPENT!":COLOR 15,4,3
2150 LOCATE 16,3:PRINT "AND SEND ALL PIRATED PROGRAMS TO..."
2160 LOCATE 18,3:PRINT "CHURCH OF THE DIVINE PROGRAMMER"
2170 LOCATE 19,3:PRINT "ANTICHRIST, VA 01666"
2180 LOCATE 23,1:PRINT TAB(10);"HIT ANY KEY TO EXIT"
2190 A$=INKEY$:IF A$="" THEN 2190
2200 COLOR 7,0,0:WIDTH 80:CLS
2210 REM